﻿<%
'''核心运行所需的基本函数,不允许删除,可在项目中直接使用
'注:本处还不能使用Sa对象、语言包
'注意本处能使用的设置值仅含底层config.asp\object.asp

'''判断三元表达式
'p_c:判断条件
'p_t:条件符合时返回值
'p_f:条件未符合返回值
Function IIF(Byval p_c, Byval p_t, Byval p_f)
	If p_c Then
		IIF = p_t
	Else
		IIF = p_f
	End If
End Function

'''二元表达式，如果条件成立则返回某个值,否则返回空字符串
'p_c:判断条件
'p_t:条件符合时返回值
Function IfThen(Byval p_c, Byval p_t)
	IfThen = IIF(p_c, p_t, "")
End Function

'''判断变量是否为空值,支持字符串、数组、记录集、Dictionary等对象
'p_s:要判断的变量
Function IsN(Byval p_s)
	IsN = False
	Select Case VarType(p_s)
	Case vbEmpty, vbNull
		IsN = True : Exit Function
	Case vbString
		If p_s="" Then
			IsN = True : Exit Function
		End If
	Case vbObject
		Select Case TypeName(p_s)
		Case "Nothing","Empty"
			IsN = True : Exit Function
		Case "Recordset"
			If p_s.State = 0 Then
				IsN = True : Exit Function
			End If
			If p_s.Bof And p_s.Eof Then
				IsN = True : Exit Function
			End If
		Case "Dictionary"
			If p_s.Count = 0 Then
				IsN = True : Exit Function
			End If
		End Select
	Case vbArray, 8194, 8204, 8209
		If Ubound(p_s) = -1 Then
			IsN = True : Exit Function
		End If
	End Select
End Function

'''判断变量是否不为空，支持字符串、数组、记录集、Dictionary等对象
'p_s:要判断的变量
Function Has(Byval p_s)
	Has = Not IsN(p_s)
End Function

'''如果某值存在返回某值，否则返回指定值
'p_o:要判断的变量
'p_t:判断值不存在时返回的指定值
Function IfHas(ByVal p_o, ByVal p_t)
	IfHas = IIF(Has(p_o), p_o, p_t)
End Function

'''获取两值的大值
'p_o:第一个值
'p_t:第二个值
Function Max(Byval p_o, Byval p_t)
	Max = IIF(p_o>=p_t, p_o, p_t)
End Function
	
'''获取两值的小值
Function Min(Byval p_o, Byval p_t)
	Min = IIF(p_o<p_t, p_o, p_t)
End Function

'''判断值是否在数组内
'p_s:进行判断的值
'p_a：被判断的数组
Function IsIn(Byval p_s, Byval p_a)
	IsIn = False
	Dim t_i
	For Each t_i In p_a
		If t_i = p_s Then
			IsIn = True : Exit Function
		End If
	Next
End Function

'''获取系统设置
'C("Debug") = IfHas(G_Debug,C_Debug)
'p_c:去掉前缀的设置名称(这里可以不区分大小写)
Function C(Byval p_c)
	p_c = Ucase(p_c)
	C = Eval("IfHas(G_" & p_c & ", C_" & p_c& ")")
End Function

'''输出字符串
'p_s:要输出的字符串
Sub W(Byval p_s)
	Response.Write(p_s)
End Sub

'''输出字符串并终止
'p_s:要输出的字符串
Sub WE(Byval p_s)
	W(p_s)
	Response.End()
End Sub

'''清空已输出并输出指定字符串并终止
'p_s:要输出的字符串
Sub CWE(Byval p_s)
	Response.Clear()
	WE(p_s)
End Sub

'''抛出底层严重错误(Serious error)
'p_s:自定义信息,一般为错误代码
Sub SE(Byval p_s)
	p_s = "System Error Happened, Error Code:" & p_s
	CWE(p_s)
End Sub

'''正则Test
'p_s:要判断的字符串
'p_p:正则表达式
Function RegTest(Byval p_s, Byval p_p)
	Dim t_r : Set t_r = New RegExp
	t_r.Global = True
	t_r.IgnoreCase = True
	t_r.Multiline = False
	If IsN(p_s) Then
		RegTest = False : Exit Function
	End If
	t_r.Pattern = p_p
	RegTest = t_r.Test(CStr(p_s))
	Set t_r = Nothing
End Function

'''底层根据正则表达式替换字符串内容
'''本函数为底层函数,外部请使用RegReplace\RegReplaceM函数
'p_s:要进行替换的字符串
'p_p:正则表达式
'p_r:替换内容,支持正则捕获组
'p_m:多行模式标识符,为1时为多行模式
Function ruleReplace_(Byval p_s, Byval p_p, Byval p_r, Byval p_m)
	Dim t_r : Set t_r = New RegExp
	t_r.Global = True
	t_r.IgnoreCase = True
	t_r.Multiline = False
	Dim t_s : t_s = p_s
	If Has(p_s) Then
		If p_m = 1 Then
			t_r.Multiline = True
		End If
		t_r.Pattern = p_p
		t_s = t_r.Replace(t_s, p_r)
	End If
	ruleReplace_ = t_s
	Set t_r = NoThing
End Function

'''根据正则表达式替换字符串内容
'p_s:要进行替换的字符串
'p_p:正则表达式
'p_r:替换内容,支持正则捕获组
Function RegReplace(Byval p_s, Byval p_p, Byval p_r)
	RegReplace = ruleReplace_(p_s, p_p, p_r, 0)
End Function

'''正则表达式编组捕获
'p_s:要判断的字符串
'p_p:正则表达式
Function RegMatch(Byval p_s, Byval p_p)
	Dim t_r : Set t_r = New RegExp
	t_r.Global = True
	t_r.IgnoreCase = True
	t_r.Multiline = False
	t_r.Pattern = p_p
	Set RegMatch = t_r.Execute(p_s)
	Set t_r = NoThing
End Function

'''截取用某个特殊字符(串)分隔的字符串的特殊字符
'''本函数为底层函数,外部请使用CLeft\CRight函数
'p_s:要截取的字符串
'p_m:特殊字符(串)
'p_t:标识位,值0时取截取左部,值1时取截取右部,其余返回空字符串
Function cutLR_(Byval p_s, Byval p_m, Byval p_t)
	Dim t_n : t_n = Instr(p_s, p_m)
	If t_n>0 Then
		If p_t = 0 Then
			cutLR_ = Left(p_s, t_n-1)
		ElseIf p_t = 1 Then
			cutLR_ = Mid(p_s, t_n + Len(p_m))
		End If
	Else
		cutLR_ = p_s
	End If
End Function

'''截取用某个特殊字符(串)分隔的字符串的特殊字符左边部分
'p_s:要截取的字符串
'p_m:特殊字符(串)
Function CLeft(Byval p_s, Byval p_m)
	CLeft = cutLR_(p_s, p_m, 0)
End Function

'''截取用某个特殊字符分隔的字符串的特殊字符右边部分
'p_s:要截取的字符串
'p_m:特殊字符(串)
Function CRight(Byval p_s, Byval p_m)
	CRight = cutLR_(p_s, p_m, 1)
End Function


'''检测某个服务器组件是否安装
'p_s:组件名
Function IsInstall(Byval p_s)
	On Error Resume Next
	IsInstall = False
	Dim t_o : Set t_o = Server.CreateObject(p_s)
	If Err.Number = 0 Then
		IsInstall = True
	End If
	Set t_o = Nothing
	Err.Clear()
End Function

'''安全化值
'p_s:值
'p_t:预计的类型,(根据该类型进行安全转化)
Function S(Byval p_s, Byval p_t)
	Dim t_s, t_d, t_l, t_r, t_i, t_t, t_a() : t_l = False
	If Instr(p_t, ":")>0 Then
		t_d = CRight(p_t, ":") : p_t = CLeft(p_t, ":")
	End If
	If Instr("sdn", Left(LCase(p_t), 1))>0 Then
		If Len(p_t)>1 Then
			t_s = Mid(p_t,2) : p_t = LCase(Left(p_t, 1)) : t_l = True
		End If
	ElseIf Has(p_t) Then
		t_s = p_t : p_t = "" : t_l = True
	End If
	t_r = Split(p_s, t_s)
	If t_l Then
		Redim t_a(Ubound(t_r))
	End If
	For t_i = 0 To Ubound(t_r)
		If t_i<>0 Then
			t_t = t_t & t_s
		End If
		Select Case p_t
		Case "s"
			If IsN(t_r(t_i)) Then
				t_r(t_i) = t_d
			End If
			t_t = t_t & Replace(t_r(t_i), "'", "''")
			If t_l Then
				t_a(t_i) = Replace(t_r(t_i), "'", "''")
			End If
		Case "d"
			t_t = IIF(IsDate(t_r(t_i)), t_t & t_r(t_i), t_t & t_d)
			If t_l Then
				t_a(t_i) = IIF(IsDate(t_r(t_i)), t_r(t_i), t_d)
			End If
		Case "n"
			t_t = IIF(IsNumeric(t_r(t_i)), t_t & t_r(t_i), t_t & t_d)
			If t_l Then
				t_a(t_i) = IIF(IsNumeric(t_r(t_i)), t_r(t_i), t_d)
			End If
		Case Else
			t_t = IIF(IsN(t_r(t_i)), t_t & t_d, t_t & t_r(t_i))
			If t_l Then
				t_a(t_i) = IIF(IsN(t_r(t_i)), t_d, t_r(t_i))
			End If
		End Select
		If t_l Then
			If IsN(t_a(t_i)) Then
				t_a(t_i) = Empty
			End If
		End If
	Next
	If IsN(t_t) Then
		t_t = Empty
	End If
	S = IIF(t_l, t_a, t_t)
End Function

'''安全GET
Function G(Byval p_s)
	Dim t_s, t_t
	If Instr(p_s,":")>0 Then
		t_t = CRight(p_s,":") : p_s = CLeft(p_s,":")
	End If
	t_s = Request.QueryString(p_s)
	G = S(t_s, t_t)
End Function

'''设置缓存记录(Application)
'p_n:缓存名称
'p_d:缓存值
Sub SetApp(Byval p_n,Byref p_d)
	Application.Lock
	If IsObject(p_d) Then
		Set Application(p_n) = p_d
	Else
	Application(p_n) = p_d
	End If
	Application.UnLock
End Sub

'''获取一个缓存(Application)记录
Function GetApp(Byval p_n)
	If IsN(p_n) Then
		GetApp = Empty : Exit Function
	End If
	If IsObject(Application(p_n)) Then
		Set GetApp = Application(p_n)
	Else
		GetApp = Application(p_n)
	End If
End Function

'''删除一个缓存记录(Application)
Sub RemoveApp(ByVal p_n)
	Application.Lock
	Application(p_n) = Empty
	Application.UnLock
End Sub

'''清除缓存
Sub ClearApp()
	Application.Contents.RemoveAll()
End Sub

'''将类似“Table:ID:Name”字符按“:”分割成数组Table\ID:Name
'p_s:要分割的字符串
Function Param(Byval p_s)
	Dim t_a(1), t_t : t_t = Instr(p_s, ":")
	If t_t > 0 Then
		t_a(0) = Left(p_s, t_t-1) : t_a(1) = Mid(p_s, t_t+1)
	Else
		t_a(0) = p_s : t_a(1) = ""
	End If
	Param = t_a
End Function

'''将类似“Table:ID:Name”字符按“:”分割成数组Name\Table:ID
'p_s:要分割的字符串
Function ParamRev(Byval p_s)
	Dim t_a(1), t_t : t_t = InstrRev(p_s, ":")
	If t_t > 0 Then
		t_a(0) = Mid(p_s, t_t+1) : t_a(1) = Left(p_s, t_t-1)
	Else
		t_a(0) = p_s : t_a(1) = ""
	End If
	ParamRev = t_a
End Function


'''构造链接
'指定p_num规则id时可以提升性能
Function U(Byval p_u, Byval p_n)
	If C_URL_MODEL = 1 Then
		U = p_u
		Exit Function
	End If
	Dim t_r, t_k, t_u : t_u = p_u
	Set t_r = New RegExp
	t_r.Global = True
	t_r.IgnoreCase = True
	t_r.Multiline = False
	If IsNumeric(p_n) Then
		If C_ROUTE_RULE.Exists(p_n) Then
			t_r.Pattern = C_ROUTE_RULE(p_n)(1)
			If t_r.Test(p_u) Then
				t_u = t_r.Replace(p_u, C_ROUTE_RULE(p_n)(2))
			Else
				t_u = p_u
			End If
		Else
			t_u = p_u
		End If
	Else
		'遍历C_ROUTE_RULE
		For Each t_k In C_ROUTE_RULE
			t_r.Pattern = C_ROUTE_RULE(t_k)(1)
			If t_r.Test(p_u) Then
				t_u = t_r.Replace(p_u, C_ROUTE_RULE(t_k)(2))
				Exit For
			End If
		Next
	End If
	Set t_r = Nothing
	U = t_u
End Function
%>